home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_guile.idb / usr / freeware / include / libguile / numbers.h.z / numbers.h
Encoding:
C/C++ Source or Header  |  1999-04-16  |  12.2 KB  |  339 lines
  1. /* classes: h_files */
  2.  
  3. #ifndef NUMBERSH
  4. #define NUMBERSH
  5. /*    Copyright (C) 1995, 1996, 1998 Free Software Foundation, Inc.
  6.  * 
  7.  * This program is free software; you can redistribute it and/or modify
  8.  * it under the terms of the GNU General Public License as published by
  9.  * the Free Software Foundation; either version 2, or (at your option)
  10.  * any later version.
  11.  * 
  12.  * This program is distributed in the hope that it will be useful,
  13.  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  14.  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15.  * GNU General Public License for more details.
  16.  * 
  17.  * You should have received a copy of the GNU General Public License
  18.  * along with this software; see the file COPYING.  If not, write to
  19.  * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  20.  * Boston, MA 02111-1307 USA
  21.  *
  22.  * As a special exception, the Free Software Foundation gives permission
  23.  * for additional uses of the text contained in its release of GUILE.
  24.  *
  25.  * The exception is that, if you link the GUILE library with other files
  26.  * to produce an executable, this does not by itself cause the
  27.  * resulting executable to be covered by the GNU General Public License.
  28.  * Your use of that executable is in no way restricted on account of
  29.  * linking the GUILE library code into it.
  30.  *
  31.  * This exception does not however invalidate any other reasons why
  32.  * the executable file might be covered by the GNU General Public License.
  33.  *
  34.  * This exception applies only to the code released by the
  35.  * Free Software Foundation under the name GUILE.  If you copy
  36.  * code from other Free Software Foundation releases into a copy of
  37.  * GUILE, as the General Public License permits, the exception does
  38.  * not apply to the code that you add in this way.  To avoid misleading
  39.  * anyone as to the status of such modified files, you must delete
  40.  * this exception notice from them.
  41.  *
  42.  * If you write modifications of your own for GUILE, it is your choice
  43.  * whether to permit this exception to apply to your modifications.
  44.  * If you do not wish that, delete this exception notice.  */
  45.  
  46.  
  47. #include "libguile/__scm.h"
  48.  
  49.  
  50.  
  51.  
  52. /* Immediate Numbers 
  53.  *
  54.  * Inums are exact integer data that fits within an SCM word.
  55.  *
  56.  * SCM_INUMP applies only to values known to be Scheme objects.
  57.  * In particular, SCM_INUMP (SCM_CAR (x)) is valid only if x is known
  58.  * to be a SCM_CONSP.  If x is only known to be a SCM_NIMP, 
  59.  * SCM_INUMP (SCM_CAR (x)) can give wrong answers.
  60.  */
  61.  
  62. #define SCM_INUMP(x)    (2 & (int)(x))
  63. #define SCM_NINUMP(x)     (!SCM_INUMP(x))
  64.  
  65. #ifdef __TURBOC__
  66. /* shifts of more than one are done by a library call, single shifts are
  67.  * performed in registers
  68.  */
  69. # define SCM_MAKINUM(x) ((((x)<<1)<<1)+2L)
  70. #else
  71. # define SCM_MAKINUM(x) (((x)<<2)+2L)
  72. #endif /* def __TURBOC__ */
  73.  
  74.  
  75. /* SCM_SRS is signed right shift */
  76. /* Turbo C++ v1.0 has a bug with right shifts of signed longs!
  77.  * It is believed to be fixed in Turbo C++ v1.01
  78.  */
  79. #if (-1==(((-1)<<2)+2)>>2) && (__TURBOC__ != 0x295)
  80. # define SCM_SRS(x, y) ((x)>>y)
  81. # ifdef __TURBOC__
  82. #  define SCM_INUM(x) (((x)>>1)>>1)
  83. # else
  84. #  define SCM_INUM(x) SCM_SRS(x, 2)
  85. # endif /* def __TURBOC__ */
  86. #else
  87. # define SCM_SRS(x, y) (((x)<0) ? ~((~(x))>>y) : (x)>>y)
  88. # define SCM_INUM(x) SCM_SRS(x, 2)
  89. #endif /*  (-1==(((-1)<<2)+2)>>2) && (__TURBOC__ != 0x295) */
  90.  
  91.  
  92. /* A name for 0.
  93.  */
  94. #define SCM_INUM0 ((SCM) 2)
  95.  
  96.  
  97.  
  98. /* SCM_FIXABLE is non-0 if its long argument can be encoded in an SCM_INUM.
  99.  */
  100. #define SCM_POSFIXABLE(n) ((n) <= SCM_MOST_POSITIVE_FIXNUM)
  101. #define SCM_NEGFIXABLE(n) ((n) >= SCM_MOST_NEGATIVE_FIXNUM)
  102. #define SCM_UNEGFIXABLE(n) ((n) <= -SCM_MOST_NEGATIVE_FIXNUM)
  103. #define SCM_FIXABLE(n) (SCM_POSFIXABLE(n) && SCM_NEGFIXABLE(n))
  104.  
  105. /* SCM_INTBUFLEN is the maximum number of characters neccessary for the
  106.  * printed or scm_string representation of an exact immediate.
  107.  */
  108.  
  109. #ifndef SCM_CHAR_BIT
  110. # define SCM_CHAR_BIT 8
  111. #endif /* ndef SCM_CHAR_BIT */
  112. #ifndef SCM_LONG_BIT
  113. # define SCM_LONG_BIT (SCM_CHAR_BIT*sizeof(long)/sizeof(char))
  114. #endif /* ndef SCM_LONG_BIT */
  115. #define SCM_INTBUFLEN (5+SCM_LONG_BIT)
  116.  
  117. /* SCM_FLOBUFLEN is the maximum number of characters neccessary for the
  118.  * printed or scm_string representation of an inexact number.
  119.  */
  120.  
  121. #define SCM_FLOBUFLEN (10+2*(sizeof(double)/sizeof(char)*SCM_CHAR_BIT*3+9)/10)
  122.  
  123.  
  124.  
  125.  
  126. /* Numbers 
  127.  */
  128.  
  129. #define SCM_INEXP(x) (SCM_TYP16(x)==scm_tc16_flo)
  130. #define SCM_CPLXP(x) (SCM_CAR(x)==scm_tc_dblc)
  131. #define SCM_REAL(x) (*(((scm_dbl *) (SCM2PTR(x)))->real))
  132. #define SCM_IMAG(x) (*((double *)(SCM_CHARS(x)+sizeof(double))))
  133. /* ((&SCM_REAL(x))[1]) */
  134.  
  135.  
  136. #ifdef SCM_SINGLES
  137. #define SCM_REALP(x) ((~SCM_REAL_PART & SCM_CAR(x))==scm_tc_flo)
  138. #define SCM_SINGP(x) (SCM_CAR(x)==scm_tc_flo)
  139. #define SCM_FLO(x) (((scm_flo *)(SCM2PTR(x)))->num)
  140. #define SCM_REALPART(x) (SCM_SINGP(x)?0.0+SCM_FLO(x):SCM_REAL(x))
  141. #else /* SCM_SINGLES */
  142. #define SCM_REALP(x) (SCM_CAR(x)==scm_tc_dblr)
  143. #define SCM_REALPART SCM_REAL
  144. #endif /* SCM_SINGLES */
  145.  
  146.  
  147. /* Define SCM_BIGDIG to an integer type whose size is smaller than long if
  148.  * you want bignums.  SCM_BIGRAD is one greater than the biggest SCM_BIGDIG. 
  149.  *
  150.  * Define SCM_DIGSTOOBIG if the digits equivalent to a long won't fit in a long. 
  151.  */
  152. #ifdef BIGNUMS
  153. # ifdef _UNICOS
  154. #  define SCM_DIGSTOOBIG
  155. #  if (1L << 31) <= SCM_USHRT_MAX
  156. #   define SCM_BIGDIG unsigned  short
  157. #  else
  158. #   define SCM_BIGDIG unsigned int
  159. #  endif /*  (1L << 31) <= USHRT_MAX */
  160. #  define SCM_BITSPERDIG 32
  161. # else
  162. #  define SCM_BIGDIG unsigned short
  163. #  define SCM_BITSPERDIG (sizeof(SCM_BIGDIG)*SCM_CHAR_BIT)
  164. # endif /* def _UNICOS */
  165.  
  166. # define SCM_BIGRAD (1L << SCM_BITSPERDIG)
  167. # define SCM_DIGSPERLONG ((scm_sizet)((sizeof(long)*SCM_CHAR_BIT+SCM_BITSPERDIG-1)/SCM_BITSPERDIG))
  168. # define SCM_DIGSPERLONGLONG ((scm_sizet)((sizeof(long long)*SCM_CHAR_BIT+SCM_BITSPERDIG-1)/SCM_BITSPERDIG))
  169. # define SCM_BIGUP(x) ((unsigned long)(x) << SCM_BITSPERDIG)
  170. # define SCM_LONGLONGBIGUP(x) ((ulong_long)(x) << SCM_BITSPERDIG)
  171. # define SCM_BIGDN(x) ((x) >> SCM_BITSPERDIG)
  172. # define SCM_BIGLO(x) ((x) & (SCM_BIGRAD-1))
  173. #endif /* def BIGNUMS */
  174.  
  175. #ifndef SCM_BIGDIG
  176. /* Definition is not really used but helps various function
  177.  * prototypes to compile with conditionalization.
  178.  */
  179. # define SCM_BIGDIG unsigned short
  180. # define SCM_NO_BIGDIG
  181. # ifndef SCM_FLOATS
  182. #  define SCM_INUMS_ONLY
  183. # endif /* ndef SCM_FLOATS */
  184. #endif /* ndef SCM_BIGDIG */
  185.  
  186. #ifdef SCM_FLOATS
  187. #define SCM_NUMBERP(x) (SCM_INUMP(x) || (SCM_NIMP(x) && SCM_NUMP(x)))
  188. #ifdef SCM_BIGDIG
  189. #define SCM_NUM2DBL(x) (SCM_INUMP (x) \
  190.             ? (double) SCM_INUM (x) \
  191.             : (SCM_REALP (x) \
  192.                ? SCM_REALPART (x) \
  193.                : scm_big2dbl (x)))
  194. #else
  195. #define SCM_NUM2DBL(x) (SCM_INUMP (x) \
  196.             ? (double) SCM_INUM (x) \
  197.             : SCM_REALPART (x))
  198. #endif
  199. #else
  200. #ifdef SCM_BIGDIG
  201. #define SCM_NUMBERP(x) (SCM_INUMP(x) || (SCM_NIMP(x) && SCM_NUMP(x)))
  202. #define SCM_NUM2DBL(x) (SCM_INUMP (x) \
  203.             ? (double) SCM_INUM (x) \
  204.             : scm_big2dbl (x))
  205. #else
  206. #define SCM_NUMBERP SCM_INUMP
  207. #define SCM_NUM2DBL(x) ((double) SCM_INUM (x))
  208. #endif
  209. #endif
  210. #define SCM_NUMP(x) ((0xfcff & (int)SCM_CAR(x))==scm_tc7_smob)
  211. #define SCM_BIGP(x) (SCM_TYP16S(x)==scm_tc16_bigpos)
  212. #define SCM_BIGSIGN(x) (0x0100 & (int)SCM_CAR(x))
  213. #define SCM_BDIGITS(x) ((SCM_BIGDIG *)(SCM_CDR(x)))
  214. #define SCM_NUMDIGS(x) ((scm_sizet)(SCM_CAR(x)>>16))
  215. #define SCM_SETNUMDIGS(x, v, t) SCM_SETCAR(x, (((v)+0L)<<16)+(t))
  216.  
  217.  
  218. #ifdef SCM_FLOATS
  219. typedef struct scm_dblproc
  220. {
  221.   char *scm_string;
  222.   double (*cproc) ();
  223. } scm_dblproc;
  224.  
  225. #ifdef SCM_SINGLES
  226. typedef struct scm_flo
  227. {
  228.   SCM type;
  229.   float num;
  230. } scm_flo;
  231. #endif
  232.  
  233. typedef struct scm_dbl
  234. {
  235.   SCM type;
  236.   double *real;
  237. } scm_dbl;
  238. #endif
  239.  
  240.  
  241.  
  242.  
  243.  
  244. extern SCM scm_exact_p SCM_P ((SCM x));
  245. extern SCM scm_odd_p SCM_P ((SCM n));
  246. extern SCM scm_even_p SCM_P ((SCM n));
  247. extern SCM scm_abs SCM_P ((SCM x));
  248. extern SCM scm_quotient SCM_P ((SCM x, SCM y));
  249. extern SCM scm_remainder SCM_P ((SCM x, SCM y));
  250. extern SCM scm_modulo SCM_P ((SCM x, SCM y));
  251. extern SCM scm_gcd SCM_P ((SCM x, SCM y));
  252. extern SCM scm_lcm SCM_P ((SCM n1, SCM n2));
  253. extern SCM scm_logand SCM_P ((SCM n1, SCM n2));
  254. extern SCM scm_logior SCM_P ((SCM n1, SCM n2));
  255. extern SCM scm_logxor SCM_P ((SCM n1, SCM n2));
  256. extern SCM scm_logtest SCM_P ((SCM n1, SCM n2));
  257. extern SCM scm_logbit_p SCM_P ((SCM n1, SCM n2));
  258. extern SCM scm_lognot SCM_P ((SCM n));
  259. extern SCM scm_integer_expt SCM_P ((SCM z1, SCM z2));
  260. extern SCM scm_ash SCM_P ((SCM n, SCM cnt));
  261. extern SCM scm_bit_extract SCM_P ((SCM n, SCM start, SCM end));
  262. extern SCM scm_logcount SCM_P ((SCM n));
  263. extern SCM scm_integer_length SCM_P ((SCM n));
  264. extern SCM scm_mkbig SCM_P ((scm_sizet nlen, int sign));
  265. extern SCM scm_big2inum SCM_P ((SCM b, scm_sizet l));
  266. extern SCM scm_adjbig SCM_P ((SCM b, scm_sizet nlen));
  267. extern SCM scm_normbig SCM_P ((SCM b));
  268. extern SCM scm_copybig SCM_P ((SCM b, int sign));
  269. extern SCM scm_long2big SCM_P ((long n));
  270. extern SCM scm_long_long2big SCM_P ((long_long n));
  271. extern SCM scm_2ulong2big SCM_P ((unsigned long * np));
  272. extern SCM scm_ulong2big SCM_P ((unsigned long n));
  273. extern int scm_bigcomp SCM_P ((SCM x, SCM y));
  274. extern long scm_pseudolong SCM_P ((long x));
  275. extern void scm_longdigs SCM_P ((long x, SCM_BIGDIG digs[]));
  276. extern SCM scm_addbig SCM_P ((SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy, int sgny));
  277. extern SCM scm_mulbig SCM_P ((SCM_BIGDIG *x, scm_sizet nx, SCM_BIGDIG *y, scm_sizet ny, int sgn));
  278. extern unsigned int scm_divbigdig SCM_P ((SCM_BIGDIG *ds, scm_sizet h, SCM_BIGDIG div));
  279. extern SCM scm_divbigint SCM_P ((SCM x, long z, int sgn, int mode));
  280. extern SCM scm_divbigbig SCM_P ((SCM_BIGDIG *x, scm_sizet nx, SCM_BIGDIG *y, scm_sizet ny, int sgn, int modes));
  281. extern scm_sizet scm_iint2str SCM_P ((long num, int rad, char *p));
  282. extern SCM scm_number_to_string SCM_P ((SCM x, SCM radix));
  283. extern int scm_floprint SCM_P ((SCM sexp, SCM port, scm_print_state *pstate));
  284. extern int scm_bigprint SCM_P ((SCM exp, SCM port, scm_print_state *pstate));
  285. extern SCM scm_istr2int SCM_P ((char *str, long len, long radix));
  286. extern SCM scm_istr2flo SCM_P ((char *str, long len, long radix));
  287. extern SCM scm_istring2number SCM_P ((char *str, long len, long radix));
  288. extern SCM scm_string_to_number SCM_P ((SCM str, SCM radix));
  289. extern SCM scm_makdbl SCM_P ((double x, double y));
  290. extern SCM scm_bigequal SCM_P ((SCM x, SCM y));
  291. extern SCM scm_floequal SCM_P ((SCM x, SCM y));
  292. extern SCM scm_number_p SCM_P ((SCM x));
  293. extern SCM scm_real_p SCM_P ((SCM x));
  294. extern SCM scm_integer_p SCM_P ((SCM x));
  295. extern SCM scm_inexact_p SCM_P ((SCM x));
  296. extern SCM scm_num_eq_p SCM_P ((SCM x, SCM y));
  297. extern SCM scm_less_p SCM_P ((SCM x, SCM y));
  298. extern SCM scm_gr_p SCM_P ((SCM x, SCM y));
  299. extern SCM scm_leq_p SCM_P ((SCM x, SCM y));
  300. extern SCM scm_geq_p SCM_P ((SCM x, SCM y));
  301. extern SCM scm_zero_p SCM_P ((SCM z));
  302. extern SCM scm_positive_p SCM_P ((SCM x));
  303. extern SCM scm_negative_p SCM_P ((SCM x));
  304. extern SCM scm_max SCM_P ((SCM x, SCM y));
  305. extern SCM scm_min SCM_P ((SCM x, SCM y));
  306. extern SCM scm_sum SCM_P ((SCM x, SCM y));
  307. extern SCM scm_difference SCM_P ((SCM x, SCM y));
  308. extern SCM scm_product SCM_P ((SCM x, SCM y));
  309. extern double scm_num2dbl SCM_P ((SCM a, char * why));
  310. extern SCM scm_divide SCM_P ((SCM x, SCM y));
  311. extern double scm_asinh SCM_P ((double x));
  312. extern double scm_acosh SCM_P ((double x));
  313. extern double scm_atanh SCM_P ((double x));
  314. extern double scm_truncate SCM_P ((double x));
  315. extern double scm_round SCM_P ((double x));
  316. extern double scm_exact_to_inexact SCM_P ((double z));
  317. extern SCM scm_sys_expt SCM_P ((SCM z1, SCM z2));
  318. extern SCM scm_sys_atan2 SCM_P ((SCM z1, SCM z2));
  319. extern SCM scm_make_rectangular SCM_P ((SCM z1, SCM z2));
  320. extern SCM scm_make_polar SCM_P ((SCM z1, SCM z2));
  321. extern SCM scm_real_part SCM_P ((SCM z));
  322. extern SCM scm_imag_part SCM_P ((SCM z));
  323. extern SCM scm_magnitude SCM_P ((SCM z));
  324. extern SCM scm_angle SCM_P ((SCM z));
  325. extern SCM scm_inexact_to_exact SCM_P ((SCM z));
  326. extern SCM scm_trunc SCM_P ((SCM x));
  327. extern SCM scm_dbl2big SCM_P ((double d));
  328. extern double scm_big2dbl SCM_P ((SCM b));
  329. extern SCM scm_long2num SCM_P ((long sl));
  330. extern SCM scm_long_long2num SCM_P ((long_long sl));
  331. extern SCM scm_ulong2num SCM_P ((unsigned long sl));
  332. extern long scm_num2long SCM_P ((SCM num, char *pos, char *s_caller));
  333. extern long num2long SCM_P ((SCM num, char *pos, char *s_caller));
  334. extern long_long scm_num2long_long SCM_P ((SCM num, char *pos, char *s_caller));
  335. extern unsigned long scm_num2ulong SCM_P ((SCM num, char *pos, char *s_caller));
  336. extern void scm_init_numbers SCM_P ((void));
  337.  
  338. #endif  /* NUMBERSH */
  339.